home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / prim / winnt.el.z / winnt.el
Encoding:
Text File  |  1998-05-21  |  6.7 KB  |  207 lines
  1. ;;; winnt.el --- Lisp routines for Windows NT.
  2.  
  3. ;; Copyright (C) 1994 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Geoff Voelker (voelker@cs.washington.edu)
  6.  
  7. ;; This file is part of GNU Emacs.
  8.  
  9. ;; GNU Emacs is free software; you can redistribute it and/or modify
  10. ;; it under the terms of the GNU General Public License as published by
  11. ;; the Free Software Foundation; either version 2, or (at your option)
  12. ;; any later version.
  13.  
  14. ;; GNU Emacs is distributed in the hope that it will be useful,
  15. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17. ;; GNU General Public License for more details.
  18.  
  19. ;; You should have received a copy of the GNU General Public License
  20. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22. ;; Boston, MA 02111-1307, USA.
  23.  
  24. ;;; Commentary:
  25.  
  26. ;; (August 12, 1993)
  27. ;; Created.
  28.  
  29. ;; (November 21, 1994)
  30. ;; [C-M-backspace] defined.
  31. ;; mode-line-format defined to show buffer file type.
  32. ;; audio bell initialized.
  33. ;;
  34. ;; (March 18, 1997)
  35. ;; Ported to XEmacs by Marc Paquette <marcpa@cam.org>
  36. ;; 
  37.  
  38. ;;; Code:
  39.  
  40. ;; Map delete and backspace
  41. ;; Not sure this is really needed in XEmacs... --marcpa
  42. (define-key global-map [(backspace)] 'backward-delete-char)
  43. (define-key global-map [(delete)] 'delete-char)
  44. (define-key global-map [(meta backspace)] 'backward-kill-word)
  45. (define-key global-map [(control meta backspace)] 'backward-kill-sexp)
  46.  
  47. ;; Show file type (text or binary) on modeline
  48. (setq-default mode-line-format
  49.   (list (purecopy "")
  50.    'mode-line-modified
  51.    'mode-line-buffer-identification
  52.    (purecopy "   ")
  53.    'global-mode-string
  54.    (purecopy "   %[(")
  55.    (purecopy "%t:")
  56.    'mode-name 'mode-line-process 'minor-mode-alist
  57.    (purecopy "%n")
  58.    (purecopy ")%]--")
  59.    (purecopy '(line-number-mode "L%l--"))
  60.    (purecopy '(column-number-mode "C%c--"))
  61.    (purecopy '(-3 . "%p"))
  62.    (purecopy "-%-")))
  63.  
  64. ;; Ignore case on file-name completion
  65. (setq completion-ignore-case t)
  66.  
  67. ;; The cmd.exe shell uses the "/c" switch instead of the "-c" switch
  68. ;; for executing its command line argument (from simple.el).
  69. (setq shell-command-switch "/c")
  70.  
  71. ;; For appending suffixes to directories and files in shell completions.
  72. (add-hook 'shell-mode-hook 
  73.       '(lambda () (setq comint-completion-addsuffix '("\\" . " "))))
  74.  
  75. ;; Use ";" instead of ":" as a path separator (from files.el).
  76. (setq path-separator ";")
  77.  
  78. ;; Set the null device (for compile.el).
  79. (setq grep-null-device "NUL")
  80.  
  81. ;; Set the grep regexp to match entries with drive letters.
  82. (setq grep-regexp-alist
  83.   '(("^\\(\\([a-zA-Z]:\\)?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 3)))
  84.  
  85. ;; Taken from dos-fn.el ... don't want all that's in the file, maybe
  86. ;; separate it out someday.
  87.  
  88. (defvar file-name-buffer-file-type-alist
  89.   '(
  90.     ("[:/].*config.sys$" . nil)        ; config.sys text
  91.     ("\\.elc$" . t)            ; emacs stuff
  92.     ("\\.\\(obj\\|exe\\|com\\|lib\\|sys\\|chk\\|out\\|bin\\|ico\\|pif\\)$" . t)
  93.                     ; MS-Dos stuff
  94.     ("\\.\\(arc\\|zip\\|pak\\|lzh\\|zoo\\)$" . t)
  95.                     ; Packers
  96.     ("\\.\\(a\\|o\\|tar\\|z\\|gz\\|taz\\)$" . t)
  97.                     ; Unix stuff
  98.     ("\\.tp[ulpw]$" . t)
  99.                     ; Borland Pascal stuff
  100.     )
  101.   "*Alist for distinguishing text files from binary files.
  102. Each element has the form (REGEXP . TYPE), where REGEXP is matched
  103. against the file name, and TYPE is nil for text, t for binary.")
  104.  
  105. (defun find-buffer-file-type (filename)
  106.   (let ((alist file-name-buffer-file-type-alist)
  107.     (found nil)
  108.     (code nil))
  109.     (let ((case-fold-search t))
  110.       (setq filename (file-name-sans-versions filename))
  111.       (while (and (not found) alist)
  112.     (if (string-match (car (car alist)) filename)
  113.         (setq code (cdr (car alist))
  114.           found t))
  115.     (setq alist (cdr alist))))
  116.     (if found
  117.     (cond((memq code '(nil t)) code)
  118.          ((and (symbolp code) (fboundp code))
  119.           (funcall code filename)))
  120.       default-buffer-file-type)))
  121.  
  122. (defun find-file-binary (filename) 
  123.   "Visit file FILENAME and treat it as binary."
  124.   (interactive "FFind file binary: ")
  125.   (let ((file-name-buffer-file-type-alist '(("" . t))))
  126.     (find-file filename)))
  127.  
  128. (defun find-file-text (filename) 
  129.   "Visit file FILENAME and treat it as a text file."
  130.   (interactive "FFind file text: ")
  131.   (let ((file-name-buffer-file-type-alist '(("" . nil))))
  132.     (find-file filename)))
  133.  
  134. (defun find-file-not-found-set-buffer-file-type ()
  135.   (save-excursion
  136.     (set-buffer (current-buffer))
  137.     (setq buffer-file-type (find-buffer-file-type (buffer-file-name))))
  138.   nil)
  139.  
  140. ;;; To set the default file type on new files.
  141. (add-hook 'find-file-not-found-hooks 'find-file-not-found-set-buffer-file-type)
  142.  
  143. ;;; For using attached Unix filesystems.
  144. (defun save-to-unix-hook ()
  145.   (save-excursion
  146.     (setq buffer-file-type t))
  147.   nil)
  148.  
  149. (defun revert-from-unix-hook ()
  150.   (save-excursion
  151.     (setq buffer-file-type (find-buffer-file-type (buffer-file-name))))
  152.   nil)
  153.  
  154. ;; Really should provide this capability at the drive letter granularity.
  155. (defun using-unix-filesystems (flag)
  156.   "Read and write files without CR/LF translation, if FLAG is non-nil.
  157. This is in effect assuming the files are on a remote Unix file system.
  158. If FLAG is nil, resume using CR/LF translation as usual."
  159.   (if flag
  160.       (progn
  161.     (add-hook 'write-file-hooks 'save-to-unix-hook)
  162.     (add-hook 'after-save-hook 'revert-from-unix-hook))
  163.     (progn
  164.       (remove-hook 'write-file-hooks 'save-to-unix-hook)
  165.       (remove-hook 'after-save-hook 'revert-from-unix-hook))))
  166.  
  167. ;;; Avoid creating auto-save file names containing invalid characters
  168. ;;; (primarily "*", eg. for the *mail* buffer).
  169. (fset 'original-make-auto-save-file-name
  170.       (symbol-function 'make-auto-save-file-name))
  171.  
  172. (defun make-auto-save-file-name ()
  173.   "Return file name to use for auto-saves of current buffer.
  174. Does not consider `auto-save-visited-file-name' as that variable is checked
  175. before calling this function.  You can redefine this for customization.
  176. See also `auto-save-file-name-p'."
  177.   (let ((name (original-make-auto-save-file-name))
  178.     (start 0))
  179.     ;; destructively replace occurences of * or ? with $
  180.     (while (string-match "[?*]" name start)
  181.       (aset name (match-beginning 0) ?$)
  182.       (setq start (1+ (match-end 0))))
  183.     name))
  184.  
  185. ;; ### FIX ME: need to look at XEmacs xmouse.el versus FSF mouse.el
  186. ;; and adjust accordingly: I think 'x-selections is an FSFism.
  187. ;; --marcpa 
  188. ;;; Fix interface to (X-specific) mouse.el
  189. (defun x-set-selection (type data)
  190.   (or type (setq type 'PRIMARY))
  191.   (put 'x-selections type data))
  192.  
  193. (defun x-get-selection (&optional type data-type)
  194.   (or type (setq type 'PRIMARY))
  195.   (get 'x-selections type))
  196.  
  197. ;; FSFisms
  198. ;(fmakunbound 'font-menu-add-default)
  199. ;(global-unset-key [C-down-mouse-1])
  200. ;(global-unset-key [C-down-mouse-2])
  201. ;(global-unset-key [C-down-mouse-3])
  202.  
  203. ;;; Set to a system sound if you want a fancy bell.
  204. ;(set-message-beep nil)
  205.  
  206. ;;; winnt.el ends here
  207.